Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/crwdemo/outputde.frm

Visual Basic Form | 1995-12-05 | 14.1 KB | 422 lines

VERSION 2.00
Begin Form Outputdest
   BackColor       =   &H00C0C0C0&
   Caption         =   "Output Destination"
   ClientHeight    =   4665
   ClientLeft      =   1905
   ClientTop       =   1560
   ClientWidth     =   5910
   Height          =   5070
   Left            =   1845
   LinkTopic       =   "Form2"
   ScaleHeight     =   4665
   ScaleWidth      =   5910
   Top             =   1215
   Width           =   6030
   Begin CommandButton Command2
      Caption         =   "Select Printer"
      Height          =   375
      Left            =   4050
      TabIndex        =   15
      Top             =   840
      Visible         =   0   'False
      Width           =   1695
   End
   Begin CommonDialog CMDialog1
      Copies          =   1
      FromPage        =   1
      Left            =   4200
      Top             =   3600
      ToPage          =   1
   End
   Begin SSCheck Check3D1
      Caption         =   "No Print Controls"
      Height          =   495
      Left            =   4020
      TabIndex        =   14
      Top             =   1410
      Width           =   1695
   End
   Begin CommandButton Command5
      Caption         =   "Help"
      Height          =   375
      Left            =   2880
      TabIndex        =   1
      Top             =   3600
      Width           =   1095
   End
   Begin CommandButton Command4
      Caption         =   "Cancel"
      Height          =   375
      Left            =   1560
      TabIndex        =   12
      Top             =   3600
      Width           =   1095
   End
   Begin CommandButton Command3
      Caption         =   "OK"
      Height          =   375
      Left            =   120
      TabIndex        =   11
      Top             =   3600
      Width           =   1215
   End
   Begin SSOption Option3D1
      Caption         =   "Export"
      Height          =   495
      Index           =   3
      Left            =   2520
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   2520
      Width           =   1215
   End
   Begin SSOption Option3D1
      Caption         =   "File"
      Height          =   495
      Index           =   2
      Left            =   480
      TabIndex        =   9
      TabStop         =   0   'False
      Top             =   2520
      Width           =   1215
   End
   Begin SSOption Option3D1
      Caption         =   "Printer"
      Height          =   495
      Index           =   1
      Left            =   2520
      TabIndex        =   8
      TabStop         =   0   'False
      Top             =   1800
      Width           =   1215
   End
   Begin SSOption Option3D1
      Caption         =   "Window"
      Height          =   495
      Index           =   0
      Left            =   495
      TabIndex        =   7
      Top             =   1800
      Value           =   -1  'True
      Width           =   1215
   End
   Begin SSFrame Frame3D2
      Height          =   1695
      Left            =   240
      TabIndex        =   6
      Top             =   1440
      Width           =   3615
   End
   Begin SSFrame Frame3D1
      Height          =   615
      Left            =   240
      TabIndex        =   5
      Top             =   600
      Width           =   3615
      Begin Label Label1
         Alignment       =   2  'Center
         BackColor       =   &H00C0C0C0&
         Caption         =   "OutPut Destination"
         Height          =   255
         Left            =   480
         TabIndex        =   2
         Top             =   240
         Width           =   2895
      End
   End
   Begin CommandButton Command1
      Caption         =   "Print"
      Height          =   375
      Left            =   4050
      TabIndex        =   4
      Top             =   360
      Width           =   1695
   End
   Begin SSPanel StatusBar
      Alignment       =   1  'Left Justify - MIDDLE
      BorderWidth     =   1
      Height          =   495
      Left            =   0
      TabIndex        =   3
      Top             =   4200
      Width           =   7335
   End
   Begin SSPanel Panel3D1
      Alignment       =   1  'Left Justify - MIDDLE
      BevelInner      =   1  'Inset
      BevelWidth      =   2
      BorderWidth     =   1
      Height          =   3015
      Left            =   120
      TabIndex        =   0
      Top             =   360
      Width           =   3855
   End
   Begin Label Label2
      Caption         =   "Label2"
      Height          =   495
      Left            =   2760
      TabIndex        =   13
      Top             =   2280
      Width           =   1215
   End
Dim ExportOptions As PEExportOptions
Dim ExportOptionsValid As Integer
Sub Command1_Click ()
Dim C As New Child
'Specify whether to turn print controls on or off
If Option3d1(0) = True Then
  If PEShowPrintControls(JobNum, True) = False Then
      RCode = GetErrorString(JobNum)
      MsgBox "PEShowPrintControls Error #: " + Str(ErrorCode) + " - " + RCode
      Exit Sub
  End If
  If Check3d1.Value = True Then
    If PEShowPrintControls(JobNum, False) = False Then
      RCode = GetErrorString(JobNum)
      MsgBox "PEShowPrintControls Error #: " + Str(ErrorCode) + " - " + RCode
      Exit Sub
    Else
      Main.Command1.Visible = True
      Main.Command2.Visible = True
      Main.Command3.Visible = True
      Main.Command4.Visible = True
      Main.Command5.Visible = True

      Unload OutputDest
      Report_ParentWindowHandle = C.hWnd
      C.Caption = "MDIChild - " & Forms.Count
     'Set the border style of the print window so that it has no border,max or min
     'buttons, control box etc.
     'Border_style% = 268435456
     'Send the Print job to be printed to a window
     If PEOutPutToWindow(JobNum, C.Caption, ScaleLeft, ScaleTop, ScaleWidth, ScaleHeight, 268435456, C.hWnd) = False Then
      RCode = GetErrorString(JobNum)
      MsgBox "PEOutputToWindow Error #: " + Str(ErrorCode) + " - " + RCode
      Exit Sub
     Else
       OutputDest!StatusBar.Caption = "Output to Window was successful."
     End If
     If PEStartPrintJob(JobNum, True) = False Then
      RCode = GetErrorString(JobNum)
      Unload C
      MsgBox "PEStartPrintJob Error #: " + Str(ErrorCode) + " - " + RCode
      Exit Sub

     Else
       OutputDest!StatusBar.Caption = "Printing to Window was successful."
     End If
    End If
  Else
  Unload OutputDest
  'Dim C1 As New Child
  Report_ParentWindowHandle = C.hWnd
  C.Caption = "Crystal MDIChild - " & Forms.Count
  'Set the border style of the print window so that it has no border,max or min
  'buttons, control box etc.
  'Border_style% = 268435456
  'Send the Print job to be printed to a window
  If PEOutPutToWindow(JobNum, C.Caption, ScaleLeft, ScaleTop, ScaleWidth, ScaleHeight, 268435456, C.hWnd) = False Then
      RCode = GetErrorString(JobNum)
      MsgBox "PEOutputToWindow Error #: " + Str(ErrorCode) + " - " + RCode
      Exit Sub

  Else
     OutputDest!StatusBar.Caption = "Output to Window was successful."
  End If
  If PEStartPrintJob(JobNum, True) = False Then
      RCode = GetErrorString(JobNum)
      Unload C
      MsgBox "PEStartPrintJob Error #: " + Str(ErrorCode) + " - " + RCode
      Exit Sub

  Else
   OutputDest!StatusBar.Caption = "Printing to Window was successful."
  End If

   Screen.MousePointer = 0
  End If
End If
  If Option3d1(1) = True Then
     'Output to printer
     MsgBox "Printer"
     Check3d1.Enabled = False
     CMDialog1.Action = 5

     Copies = CMDialog1.Copies
     'Need to trap if user hits cancel in Commondialogue somehow
     If PEOutputToPrinter(JobNum, Copies) = False Then
      RCode = GetErrorString(JobNum)
      MsgBox "PEOutputToPrinter Error #: " + Str(ErrorCode) + " - " + RCode
      Exit Sub
     Else
        OutputDest!StatusBar.Caption = "Output to printer Successful."
     End If
     If PEStartPrintJob(JobNum, True) = False Then
      RCode = GetErrorString(JobNum)
      MsgBox "PEStartPrintJob Error #: " + Str(ErrorCode) + " - " + RCode
      Exit Sub
     Else
        OutputDest!StatusBar.Caption = "Printing to Printer was successful."
     End If

   End If
  If Option3d1(2) = True Then
     MsgBox "Note: File format will be Character Seperated with a string delimiter of a single quote and a field delimiter of a comma. To output to any other file formats please refer to the documentation and modify the code manually. Otherwise it is recommended that the Export option be used."
    'Output to File
    Check3d1.Enabled = False
  Dim FileName As String, Msg As String
  Dim choice As Integer, FileType As Integer
  'Dim Options As PEPrintFileOptions
  Dim Options As PECharSepFileOptions
  FileName = InputBox("Please Enter Report File Name with full path:", "Report File Name")
  'FileType = PE_FT_TABSEPERATED
  FileType = PE_FT_CHARSEPARATED
  Options.StructSize = Len(Options)  ' Initialize size of structure
  Options.UseReportNumberFmt = False
  Options.UseReportDateFormat = True
  Options.StringDelimiter = "'"
  Options.FieldDelimiter = "," + Chr$(0)
  ' We can't output to the file, unless it does not exist. Therefore
  ' Check for the existence of the file.  If it does exist check with
  ' the user to see if we can erase it.
  If exists(FileName) Then
    Msg = FileName + " already exits.  OK to overwrite?"
    choice = MsgBox(Msg, 36)
    If choice = 6 Then  ' The user said yes
      Kill FileName
      If PEOutputToFile(JobNum, FileName, FileType, Options) = False Then
        ' Handle error
      RCode = GetErrorString(JobNum)
      MsgBox "PEOutputToFile Error #: " + Str(ErrorCode) + " - " + RCode
      Exit Sub
      Else
        OutputDest!StatusBar.Caption = "Output to file Successful."
        If PEStartPrintJob(JobNum, True) = False Then
          RCode = GetErrorString(JobNum)
          MsgBox "PEStartPrintJob Error #: " + Str(ErrorCode) + " - " + RCode
          Exit Sub
        Else
          OutputDest!StatusBar.Caption = "Printing to File was successful."
        End If
      End If
    End If
  Else
    If PEOutputToFile(JobNum, FileName, FileType, Options) = False Then
      ' Handle error
      RCode = GetErrorString(JobNum)
      MsgBox "PEOutputToFile Error #: " + Str(ErrorCode) + " - " + RCode
      Exit Sub
    Else
        OutputDest!StatusBar.Caption = "Output to file Successful."

    End If
  End If
  End If
  If Option3d1(3) = True Then
    If JobNum = 0 Then
        MsgBox "Job not open"
        Exit Sub
    End If
    If ExportOptionsValid = 0 Then
        Call InitExportOptions
    End If
    ' PEGetExportOptions gets complete information about format and
    ' destination for the export
    ' The ExportOptions must be passed to PEExportTo before calling PEStartPrintJob
    ExportOptionsValid = PEGetExportOptions(JobNum, ExportOptions)

    If ExportOptionsValid = 0 Then
        Call InitExportOptions
    End If
    ' Whenever you call PEExportTo, you must ensure that the format
    ' and dll names have been filled in
    ' You can do this by assigning specific names (as InitExportOptions does)
    ' or by calling PEGetExportOptions
    ' If the ExportOptions structure doesn't contain all information needed
    ' by a format or destination dll, it will ask for the information
    ' when you call PEStartPrintJob
    ' An ExportOptions structure filled in by PEGetExportOptions always has
    ' all the information needed by both dll's
    ExportOptionsValid = PEExportTo(JobNum, ExportOptions)
    If ExportOptionsValid = 0 Then
        RCode = GetErrorString(JobNum)
        MsgBox "PEExportTo Error #: " + Str(ErrorCode) + " - " + RCode
        MsgBox "Cannot print - no export options"
        Exit Sub
    End If
    If PEStartPrintJob(JobNum, True) = False Then
       RCode = GetErrorString(JobNum)
       MsgBox "PEStartPrintJob Error #: " + Str(ErrorCode) + " - " + RCode
       Exit Sub
    Else
       OutputDest!StatusBar.Caption = "Export was successful."
    End If
    Check3d1.Enabled = False
  End If
End Sub
Sub Command3_Click ()
 Unload Me
End Sub
Sub Command4_Click ()
 Unload Me
End Sub
Sub Command5_Click ()
 RCode = Shell("Winhelp c:\crw\crw.hlp", 3)
 If RCode = False Then
   MsgBox ("RedPoint cannot find the Crystal Help file in C:\CRW directory")
 End If
End Sub
Function exists (f As String) As Integer
' What follows is code for the exists function
' This function returns True if a given file exists, False otherwise
  Dim n As Integer
  On Error GoTo handler
  n = FreeFile
  ' Try to open file for input.  If successful, file exists
  Open f For Input As #n
  Close #n
  exists = True
  Exit Function
handler:
  ' If we get here the file does not exist
  exists = False
  Exit Function
End Function
Sub Form_Load ()
 OutputDest!StatusBar.Caption = "Ready"
End Sub
Sub InitExportOptions ()
    ExportOptions.StructSize = Len(ExportOptions)
    ExportOptions.FormatDLLName = "uxftext" + Chr$(0)
    ExportOptions.FormatType = 0
    ExportOptions.FormatOptions = 0
    ExportOptions.DestinationDLLName = "uxddisk" + Chr$(0)
    ExportOptions.DestinationType = 0
    ExportOptions.DestinationOptions = 0
    ExportOptions.NFormatOptionsBytes = 0
    ExportOptions.NDestinationOptionsBytes = 0
    ExportOptionsValid = 0
End Sub
Sub Option3D1_Click (Index As Integer, Value As Integer)
 If Option3d1(0).Value = True Then
    Check3d1.Enabled = True
    Command1.Caption = "Print"
    Command2.Visible = False
 End If
 If Option3d1(1).Value = True Then
   Command1.Caption = "Print"
   Check3d1.Enabled = False
   Command2.Visible = True
 End If
 If Option3d1(2).Value = True Then
   Command1.Caption = "Print"
   Check3d1.Enabled = False
 End If
 If Option3d1(3).Value = True Then
   Command1.Caption = "Export"
   Check3d1.Enabled = False
 End If
End Sub